home *** CD-ROM | disk | FTP | other *** search
/ BMUG Revelations / BMUG Revelations.toast / Programming / Programming Languages / Yerk 3.64 / Float source / fpCode < prev    next >
Text File  |  1990-12-22  |  6KB  |  198 lines
  1. \ code words for floating point support
  2. \  8/13/85  cbd Version 1.0
  3. \  1/24/86  gdc Moved f0=, f0>, and f0< to fpcode.
  4.  
  5. \ ( flt1 flt2 -- abs1 abs2)  set up stack for comparison, kill floats
  6. \ leaves D0,D1 and a0,a1 undefined.
  7. :CODE  (fcmp2)      \ ***** subroutine ****
  8.         move.l  (A7)+,a2
  9.         move.l  (A7)+,D1    ; get 2 floats in D0,D1
  10.         move.l  (A7)+,D0
  11.         pea     2(A3,D1.l)  ; push abs data addresses
  12.         pea     2(A3,D0.l)
  13.         move.l  YERK[(fltDisp2)],d7     ; get subr addr in d7
  14.         jsr     0(a3,d7.l)              ; go kill floats in D0,D1
  15.         jmp     (a2)
  16. ;CODE
  17.  
  18. \ =================== Comparison operators ==============
  19. \ Stack frame for all comparisons:
  20. \ ( float1 float2 -- bool )
  21. :CODE f>
  22.         move.l  YERK[(fcmp2)],d7     ; get subr addr in d7
  23.         jsr     0(a3,d7.l)           ; go kill floats in D0,D1
  24.         MOVE.W  #8,-(A7)    ; code for FCMPX
  25.         call    pack4
  26.         sgt     D0
  27.         move.l  D0,-(A7)
  28. ;CODE
  29.  
  30. :CODE f<
  31.         move.l  YERK[(fcmp2)],d7     ; get subr addr in d7
  32.         jsr     0(a3,d7.l)              ; go kill floats in D0,D1
  33.         MOVE.W  #8,-(A7)    ; code for FCMPX
  34.         call    pack4           
  35.         slt     D0
  36.         move.l  D0,-(A7)
  37. ;CODE
  38.  
  39. :CODE f=  
  40.         move.l  YERK[(fcmp2)],d7     ; get subr addr in d7
  41.         jsr     0(a3,d7.l)              ; go kill floats in D0,D1
  42.         MOVE.W  #8,-(A7)    ; code for FCMPX
  43.         call pack4           
  44.         seq     D0
  45.         move.l  D0,-(A7)
  46. ;CODE
  47.  
  48. :CODE f<>  
  49.         move.l  YERK[(fcmp2)],d7     ; get subr addr in d7
  50.         jsr     0(a3,d7.l)              ; go kill floats in D0,D1
  51.         MOVE.W  #8,-(A7)    ; code for FCMPX
  52.         call pack4           
  53.         sne     D0
  54.         move.l  D0,-(A7)
  55. ;CODE
  56.  
  57. :CODE f<=  
  58.         move.l  YERK[(fcmp2)],d7     ; get subr addr in d7
  59.         jsr     0(a3,d7.l)              ; go kill floats in D0,D1
  60.         MOVE.W  #8,-(A7)    ; code for FCMPX
  61.         call pack4           
  62.         sle     D0
  63.         move.l  D0,-(A7)
  64. ;CODE
  65.  
  66. :CODE f>=  
  67.         move.l  YERK[(fcmp2)],d7     ; get subr addr in d7
  68.         jsr     0(a3,d7.l)              ; go kill floats in D0,D1
  69.         MOVE.W  #8,-(A7)    ; code for FCMPX
  70.         call pack4           
  71.         sge     D0
  72.         move.l  D0,-(A7)
  73. ;CODE
  74.  
  75. \ ================ Arithmetic operators ==============
  76. \ ( flt1 flt2 -- abs2 abs1)  set up stack for operator, kill float in d0
  77. :CODE  (fp1)      \ ***** subroutine ****
  78.         move.l  (A7)+,a2    ; hold return address 
  79.         move.l  (A7)+,D0    ; get 2 floats in D0,D1
  80.         move.l  (A7)+,D1    ; 
  81.         pea     2(A3,D0.l)  ; push abs data addresses       
  82.         pea     2(A3,D1.l)  ; example op:  f1 - f2 -> f1       
  83.         move.l  YERK[(fltDisp)],d7     ; get subr addr in d7
  84.         jsr     0(a3,d7.l)              ; go kill float in D0
  85.         jmp     (a2)
  86. ;CODE
  87. \ --------------------------------------
  88. \ ( f1 f2 -- f1+f2)  result gets stored in f2's data 
  89. :CODE f+  
  90.         move.l  YERK[(fp1)],d7     ; get subr addr in d7
  91.         jsr     0(a3,d7.l)              ; go kill float  in D0 
  92.         clr.w   -(A7)    ; code for FADD
  93.         call pack4           
  94.         move.l  D1,-(A7)    ; 
  95. ;CODE
  96.  
  97. :CODE f-  
  98.         move.l  YERK[(fp1)],d7     ; get subr addr in d7
  99.         jsr     0(a3,d7.l)              ; go kill float  in D0 
  100.         MOVE.W  #2,-(A7)    ; code for FSUB
  101.         call pack4           
  102.         move.l  D1,-(A7)    ; 
  103. ;CODE
  104.  
  105. :CODE f*  
  106.         move.l  YERK[(fp1)],d7     ; get subr addr in d7
  107.         jsr     0(a3,d7.l)              ; go kill float  in D0 
  108.         MOVE.W  #4,-(A7)    ; code for FMULT
  109.         call pack4           
  110.         move.l  D1,-(A7)    ; 
  111. ;CODE
  112.  
  113. :CODE f/  
  114.         move.l  YERK[(fp1)],d7     ; get subr addr in d7
  115.         jsr     0(a3,d7.l)              ; go kill float  in D0 
  116.         MOVE.W  #6,-(A7)    ; code for FDIV
  117.         call pack4           
  118.         move.l  D1,-(A7)    ; 
  119. ;CODE
  120.  
  121. \ floating point modulus function
  122. :CODE fMod        
  123.         move.l  YERK[(fp1)],d7     ; get subr addr in d7
  124.         jsr     0(a3,d7.l)              ; go kill float  in D0 
  125.         MOVE.W  #12,-(A7)               ; code for FREM
  126.         call pack4           
  127.         move.l  D1,-(A7)    ; 
  128. ;CODE
  129.  
  130.  
  131. \ ============= unary operations ==============
  132. :CODE fNegate  
  133.         move.l  (A7),D0
  134.         pea     2(A3,D0.l)         
  135.         MOVE.W  #13,-(A7)     
  136.         call pack4           
  137. ;CODE
  138.  
  139. :CODE fAbs  
  140.         move.l  (A7),D0
  141.         pea     2(A3,D0.l)         
  142.         MOVE.W  #15,-(A7)     
  143.         call pack4           
  144. ;CODE
  145.  
  146. :CODE sqrt  
  147.         move.l  (A7),D0
  148.         pea     2(A3,D0.l)         
  149.         MOVE.W  #18,-(A7)     
  150.         call pack4           
  151. ;CODE
  152.  
  153. :CODE round  
  154.         move.l  (A7),D0
  155.         pea     2(A3,D0.l)         
  156.         MOVE.W  #20,-(A7)     
  157.         call pack4           
  158. ;CODE
  159.  
  160. :CODE trunc  
  161.         move.l  (A7),D0
  162.         pea     2(A3,D0.l)         
  163.         MOVE.W  #22,-(A7)     
  164.         call pack4           
  165. ;CODE
  166.  
  167. :CODE logBin  
  168.         move.l  (A7),D0
  169.         pea     2(A3,D0.l)         
  170.         MOVE.W  #26,-(A7)     
  171.         call pack4           
  172. ;CODE
  173.  
  174. \ ========= conversion to/from Yerk longInt  
  175. ( flt -- int32)
  176. :CODE float>  
  177.         move.l  (A7),D0             ; get source float
  178.         move.l  YERK[(fltDisp)],d7     ; get subr addr in d7
  179.         jsr     0(a3,d7.l)             ; go kill floats in D0 
  180.         move.l  (A7),D0             ; get source float
  181.         move.l  a7,a0           ; save ptr to the cell
  182.         pea     2(A3,D0.l)         
  183.         move.l  a0,-(a7)        ; push ptr to the cell 
  184.         MOVE.W  #10256,-(A7)    ; $2810   
  185.         call pack4           
  186. ;CODE
  187.  
  188. \ ( int32 -- fp )
  189. :CODE >float  
  190.         move.l  a7,-(a7)    ; push ptr to the long
  191.         move.l  YERK[(fltNew)],d7       ; get subr addr in d7
  192.         jsr     0(a3,d7.l)              ; go get float in D1
  193.         pea     2(a3,d1.l)                ; push addr of float
  194.         MOVE.W  #10254,-(A7)            ; $280e
  195.         call pack4           
  196.         move.l  D1,(A7)    ;  replace the long cell with float ptr
  197. ;CODE
  198.